(defpackage :fill-task
  (:use :cl)
  (:import-from :rollover-input :popup-keypad :keypad-input)
  (:import-from :selection-task :submit-answer)
  (:export :fill-input
           :crap-keypad
           :submit-answer))

(in-package :fill-task)

(defclass special-tree (new-tree:new-tree)
  ((wrong :initform nil :accessor wrong)))

(defmethod gwee:draw-view :after ((view special-tree))
  (loop for pair in (wrong view)
     for arg = (d:find-node-by-id (d:root view) (first pair))
       for answer = (second pair)
       for text = (u:string2 answer)
       for text-width = (max (sdl:get-font-size text :size :w :font (gwee:view-font view))
                             50)
       for left = (eq arg (d:box-left-arg (tree:parent arg)))
       for x = (if left
                   (- (geom:x arg) text-width 50)
                   (+ (geom:right arg) 30))
       for y = (geom:centery arg)
     do (gwee:draw-rectangle view x (geom:y arg) (+ text-width 20) (geom:height arg)
                          :filled t
                          :color (gwee:color 255 0 0))
       (gwee:draw-trigon view
                         (if left (+ x text-width 20) x) (- (geom:y arg) 10)
                         (if left (+ x text-width 20) x) (+ (geom:bottom arg) 10)
                         (if left (+ x text-width 40) (- x 20)) (geom:centery arg)
                         :filled t
                         :color (gwee:color 255 0 0))
     (gwee:draw-text view text (+ x (u:half text-width) 10) y
                     :color (gwee:gray 255)
                     :x-alignment :center
                     :y-alignment :center)))

(gwee:define-component fill-task (exp:stimulus-input-feedback)
  ((tree1 :initarg :tree1 :accessor tree1)
   (tree2 :initarg :tree2 :accessor tree2)
   (wrong :initform nil :accessor wrong)
   (reward :initform 4 :initarg :reward :accessor reward)
   (callback-data :accessor callback-data))
  (:views
   (divider gwee:divider
            :margin-bottom 0
            :direction :vertical
            :foreground (gwee:gray 150))
   (divider2 gwee:divider
             :margin-bottom 0
             :direction :vertical
             :foreground (gwee:gray 150))
   (diagram1 new-tree:new-tree :accessor diagram1)
   (diagram2 new-tree:new-tree :accessor diagram2)
   ;; (subject-text gwee:text-area :y :top :x :center :margin-top 50 :data "Your Answer" :font (gwee:open-font "sans.ttf" 46))
   ;; (answer-text gwee:text-area :y :top :x :center :margin-top 50 :data "Correct Answer" :font (gwee:open-font "sans.ttf" 46))
   (correct-diagram new-tree:new-tree :accessor correct-diagram)
   (feedback gwee:text-area :margin-top 75 :y :top :x :center :data " " :font (gwee:open-font "sans.ttf" 46) :name :feedback)
   (done gwee:button :width 100 :height 40 :data "Done"))
  (:layouts
   (default gwee:switchable-layout
        (top feedback-overlay)
     :name :default)
   (feedback-overlay gwee:view
                     (feedback-layout))
   (feedback-layout gwee:row-layout
             (correct-diagram divider2 subject-diagram-area))
   (subject-diagram-area gwee:column-layout
                         (subject-diagram)
                         :margin-bottom 90)
   (subject-diagram special-tree;;new-tree:new-tree
                    (feedback)
                    :accessor subject-diagram)
   (problem gwee:column-layout
            (diagram2 done)
            :margin-bottom 50)
   (top gwee:row-layout
       (diagram1 divider problem)))
  (:default-initargs
    :task-time 60))

(defmethod exp:state-dump append (exp (state fill-task))
  `(:tree1 ,(u:sharp-dot (tree1 state))
    :tree2 ,(u:sharp-dot (tree2 state))
    :reward ,(reward state)))

(defun collapse-inputs (root)
  (d:funcall-on-tree (lambda (input)
                       (setf (d:quantity input) (u:string2 (d:answer input)))
                       (o:collapse-input-argument input))
                     root
                     :only-type 'd:input-argument))

(defun fill-in-blanks (tree)
  (labels ((doop (op)
             (multiple-value-bind (match root vars selections-needed)
                 (o:find-transformation-for tree (o:transformations op) t)
               (declare (ignore root vars))
               (when match
                 (dolist (s selections-needed)
                   (setf (d:selected s) t))
                 (o:perform-operation tree op)
                 (collapse-inputs tree)
                 t))))
    (let ((up (make-instance 'o:operation :transformations (nd::nd-invert-transformations :minimum)))
          (down (make-instance 'o:operation :transformations (nd::nd-evaluate-transformations :minimum))))
      (loop while (or (doop up) (doop down))))))

(defun add-to-input (node value)
  (exp:lg 'input :node (d:id node) :value value))

(defun leave (node)
  (exp:lg 'leave :node (d:id node)))

(defun enter (node)
  (exp:lg 'enter :node (d:id node)))

(defmethod exp:state-init (exp (state fill-task))
  (with-slots (diagram1 diagram2 tree1 tree2 correct-diagram wrong done callback-data) state
    (setf (d:root diagram1) (tree:recreate-parent-slots (d:merge-by-id (tree:copy-node tree1 t)))
          (d:root diagram2) (tree:recreate-parent-slots (d:merge-by-id (tree:copy-node tree2 t)))
          (gwee:click-callback done)
          (exp:dispatch-event-fn exp state exp:click-event :source :done))
    (multiple-value-bind (cb data) (bfc:make-callback diagram2
                                                      :leave (lambda (d n)
                                                               (declare (ignore d))
                                                               (leave n))
                                                      :enter (lambda (d n)
                                                               (declare (ignore d))
                                                               (enter n))
                                                      :input-must-be-correct nil
                                                      :add-to-input (lambda (d n v)
                                                                      (declare (ignore d))
                                                                      (add-to-input n v))
                                                      ;; :input-collapsed (lambda (d n c)
                                                      ;;                    (declare (ignore d))
                                                      ;;                    (input-collapsed state n c))
                                                      ;; :all-inputs-collapsed (lambda (d)
                                                      ;;                         (declare (ignore d))
                                                      ;;                         (exp:do-feedback state nil))
                                                      :no-collapse t)
      (setf (d:event-callback diagram2) cb
            callback-data data))
    (setf (d:root correct-diagram) (tree:copy-node (d:root diagram1) t)
          wrong (mapcar (lambda (n)
                          (list (d:id n) (d:answer n)))
                        (d:collect-on-tree (constantly t) (d:root diagram2) :only-type 'd:input-argument)))
    (exp:lg 'start :diagram1 (u:sharp-dot (d:root diagram1)) :diagram2 (u:sharp-dot (d:root diagram2)))
    (collapse-inputs (d:root correct-diagram))
    (gwee:sync-views)
    (d:update-diagram-view correct-diagram)
    (d:update-diagram-view diagram1)
    (d:update-diagram-view diagram2)))

(defun convert (tree)
  (append (dgraph:convert tree)
          (dgraph:attributes tree)))

(defmethod exp:state-list-objects append (exp (state fill-task))
  (with-slots (default top diagram1 diagram2 feedback
               correct-diagram subject-diagram) state
    (if (eq (gwee:switchable-layout-current-view default) top)
        (list :buttons '(:done)
              :keypad (when (bfc::find-keypad (diagram2 state))
                        (d:id (keypad:target (bfc::find-keypad (diagram2 state)))))
              :left-tree (convert (d:root diagram1))
              :right-tree (convert (d:root diagram2)))
        (list :buttons nil
              :left-tree (convert (d:root correct-diagram))
              :right-tree (convert (d:root subject-diagram))
              :feedback (gwee:view-data feedback)
              :red-arrows (mapcar (lambda (w)
                                    (list :node (first w) :answer (second w)))
                                  (wrong subject-diagram))))))

(defmethod exp:state-list-actions append (experiment (state fill-task))
  (exp::default-list-actions state))

(exp:define-action submit-answer ((state fill-task)
                                  (exp:click :source :done))
  (exp:do-feedback state nil))

(exp:define-state-match keypad ((state fill-task))
  (bfc::find-keypad (diagram2 state)))

(exp:define-state-match problem-mode ((state fill-task))
    (with-slots (default top) state
      (eq (gwee:switchable-layout-current-view default) top)))

(exp:define-state-match feedback-mode ((state fill-task))
  (with-slots (default feedback-overlay) state
    (eq (gwee:switchable-layout-current-view default) feedback-overlay)))

(exp:define-event-match keypad-input ((state fill-task)
                                      (event kp:keypad-event))
  (kp:keypad-event-value event))

(exp:define-action keypad-input ((state fill-task)
                                 (keypad-input :var value)
                                 (keypad :var keypad)
                                 (problem-mode))
  (bfc::kp-callback (diagram2 state)
                    keypad
                    value
                    (callback-data state)))

;; (defmethod e::translate-leave (exp (state fill-task) &key node)
;;   (make-instance 'e:motion-event
;;                  :enter nil
;;                  :leave node))

;; (defmethod e::translate-enter (exp (state fill-task) &key node)
;;   (make-instance 'e:motion-event
;;                  :leave nil
;;                  :enter node))

;; (exp:define-event-match leave ((state fill-task)
;;                                (event e:motion-event))
;;   (e:leave event))

;; (exp:define-action leave ((state fill-task)
;;                           (leave)
;;                           (keypad :var keypad)
;;                           (problem-mode))
;;   (bfc::close-keypad (diagram2 state) keypad (callback-data state)))

;; (exp:define-event-match enter ((state fill-task)
;;                                (event e:motion-event))
;;   (e:enter event))

(exp:define-event-match motion ((state fill-task)
                               (event e:motion-event))
  (list :enter (e:enter event) :leave (e:leave e:leave)))

(exp:define-action popup-keypad ((state fill-task)
                                 (motion :var motion)
                                 (problem-mode))
  (when (getf motion :leave)
    (bfc::close-keypad (diagram2 state)
                       (bfc::find-keypad (diagram2 state))
                       (callback-data state)))
  (when (getf motion :enter)
    (let ((node (d:find-id-or-die (d:root (diagram2 state))
                                  (getf motion :enter))))
      (bfc::delete-inputs (diagram2 state))
      (bfc::open-keypad-for (diagram2 state) node (callback-data state)))))

(defun collapse-input-tiles (state)
  (with-slots (diagram2) state
    (let ((inputs (d:collect-on-tree (constantly t) (d:root diagram2)
                                     :only-type 'd:input-argument)))
      (exp:lg 'input-tile-values :values (mapcar (lambda (i) (list (d:id i) (d:quantity i))) inputs))
      (dolist (node inputs)
        (when (string= (d:quantity node) (u:string2 (d:answer node)))
          (setf (wrong state) (remove (d:id node) (wrong state) :key 'first))))
      (mapc 'o:collapse-input-argument inputs))))

(defmethod exp:show-answer ((state fill-task) timed-out)
  (with-slots (default feedback-overlay feedback diagram2 correct-diagram subject-diagram wrong) state
    (collapse-input-tiles state)
    (let ((correct (and (not wrong) (not timed-out)))
          color)
      (setf (gwee:switchable-layout-current-view default) feedback-overlay)
      (exp:lg 'show-answer :correct-tree (u:sharp-dot (d:root correct-diagram)) :correct correct)
      (when correct
        (incf (exp:reward exp:*experiment*) (reward state)))
      (cond
        (timed-out
         (setf (gwee:view-data feedback) "Time's Up"
               color (gwee:color 255 0 0)))
        (wrong
         (setf (gwee:view-data feedback) "Incorrect!"
               color (gwee:color 255 0 0)))
        (t
         (setf (gwee:view-data feedback) "Correct!"
               color (gwee:color 0 255 0))))
      (setf (gwee:foreground-color feedback) color
            (d:root subject-diagram) (d:root diagram2)
            (wrong subject-diagram) wrong
            (gwee:view-needs-sync-p default) t)
      (d:update-diagram-view subject-diagram)
      wrong)))

(defun input-collapsed (state node correct)
  (exp:lg 'collapsed :node (d:id node) :value (d:quantity node) :correct correct)
  (when correct
    (setf (wrong state) (remove (d:id node) (wrong state) :key 'first))))

(defun fix-node-ids (root)
  (d:funcall-on-tree (lambda (node)
                       (when (symbolp (d:id node))
                         (setf (d:id node) (d::get-unique-id))))
                     root)
  root)

(defun read-problems (file dir)
  (with-open-file (s (gwee:resource (format nil "~a/~a.txt" dir file)))
    (let ((lines (loop for line = (read-line s nil s)
                    until (eq line s)
                    do (setf line (string-trim " 	" line))
                    when (plusp (length line))
                    collect line)))
      (loop for rest = lines then (cddr rest)
         while rest
         for p1 = (first rest)
         for p2 = (or (second rest) "(b1)")
         collect `(fill-task :tree1 ,(fix-node-ids (tree:recreate-parent-slots (d:merge-by-id (sf:parse-graph p1)))) :tree2 ,(fix-node-ids (tree:recreate-parent-slots (d:merge-by-id (sf:parse-graph p2)))))))))

(defun main ()
  (let ((transfer-problems (read-problems "2d-multiple-two")))
    (exp:run-experiment
     `((:fill-task ,@transfer-problems))
     :title "Fill Task"
     :resizable t
     :width 1024
     :height 768
     :version (boxes.util:version))))

(defun fix-file (file)
  (with-open-file (s (gwee:resource (format nil "transfer/~a.txt" file)))
    (with-open-file (out (gwee:resource (format nil "transfer/~a.new.txt" file))
                         :direction :output
                         :if-exists :supersede)
      (let ((lines (loop for line = (read-line s nil s)
                         until (eq line s)
                         do (setf line (string-trim " 	" line))
                         when (plusp (length line))
                           collect line)))
        (loop for line in lines
              for tree = (tree:recreate-parent-slots (d:merge-by-id (sf:parse-graph line)))
              do (d::reset-id-counter)
                 (d:funcall-on-tree (lambda (node)
                                      (setf (d:id node) (d::get-unique-id)))
                                    tree)
                 (format out "~{~s~^ ~}~%" (dgraph::convert2 tree)))))))

(defun randomize-order (file)
  (with-open-file (s (gwee:resource (format nil "l4-sessions/~a.txt" file)))
    (with-open-file (out (gwee:resource (format nil "l4-sessions/~a.new.txt" file))
                         :direction :output
                         :if-exists :supersede)
      (let* ((lines (loop for line = (read-line s nil s)
                          until (eq line s)
                          do (setf line (string-trim " 	" line))
                          when (plusp (length line))
                            collect line))
             (pairs (u:randomize-list
                     (loop for rest = lines then (cddr rest)
                           while rest
                           for left = (first rest)
                           for right = (second rest)
                           collect (list left right)))))
            (loop for p in pairs
                  do (write-line (first p) out)
                     (write-line (second p) out))))))
